home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / PROGRAMM / DB_CLIPP / 0264.ZIP / GEMINI.PAS < prev    next >
Pascal/Delphi Source File  |  1985-11-24  |  5KB  |  197 lines
  1. program geminiset;
  2. var
  3.   dev:text;
  4.  
  5. procedure start;
  6.  
  7. begin
  8.   textbackground(blue);
  9.   graphbackground(blue);
  10.   clrscr;
  11.   window (48,1,79,10);
  12.   clrscr;
  13.   gotoxy (1,1);
  14.   writeln ('GEMINI Printer Control Menu');
  15.   writeln ('George Goldberg - Phoenix');
  16.   writeln;
  17.   writeln ('Keep choosing letters till your');
  18.   writeln ('printer is set how you want it');
  19.   writeln ('Then push Q to quit program');
  20. end;
  21.  
  22. procedure printsize;
  23. begin
  24.   window (1,2,30,18);
  25.   textbackground(cyan);
  26.   textcolor (black);
  27.   clrscr;
  28.   gotoxy(3,2);
  29.   writeln ('PRINTSIZE MENU');
  30.   writeln;
  31.   writeln (' A  Pica');
  32.   writeln (' B  Elite');
  33.   writeln (' C  Compressed');
  34.   writeln (' D  Pica    enlarged');
  35.   writeln (' E  Elite   enlarged');
  36.   writeln (' F  Comprsd enlarged');
  37.   end;
  38.  
  39. procedure left;
  40. begin
  41.   window (4,12,40,20);
  42.   textbackground(black);
  43.   textcolor (yellow);
  44.   clrscr;
  45.   gotoxy(3,2);
  46.   writeln ('SIZE OF LEFT MARGIN MENU');
  47.   writeln;
  48.   writeln (' L   0.00 inch margin');
  49.   writeln (' M   0.50 inch margin');
  50.   writeln (' N   0.75 inch margin');
  51.   writeln (' O   1.00 inch margin');
  52.   writeln (' P   1.50 inch margin');
  53.   end;
  54.  
  55. procedure printquality;
  56. begin
  57.   window (25,3,46,15);
  58.   textcolor(blue);
  59.   textbackground (green);
  60.   clrscr;
  61.   gotoxy (3,2);
  62.   writeln ('PRINT QUALITY MENU');
  63.   writeln;
  64.   writeln (' G  Standard ASCII');
  65.   writeln (' H  Italic ASCII');
  66.   writeln (' I  Double Strike');
  67.   writeln (' J  Emphasized (pica)');
  68.   writeln (' K  Underline');
  69. end;
  70.  
  71. procedure linespace;
  72. begin
  73.   window (32,11,71,20);
  74.   textbackground(brown);
  75.   textcolor (black);
  76.   clrscr;
  77.   gotoxy(3,2);
  78.   writeln ('LINE SPACING MENU');
  79.   writeln;
  80.   writeln (' R   4 lines per inch');
  81.   writeln (' S   6 lines per inch');
  82.   writeln (' T   8 lines per inch');
  83.   writeln (' U  10 lines per inch');
  84.   end;
  85.  
  86. procedure linesperpage;
  87. begin
  88.   window (55,12,79,25);
  89.   textbackground(white);
  90.   textcolor (blue);
  91.   clrscr;
  92.   gotoxy(3,2);
  93.   writeln ('LINES PER PAGE MENU');
  94.   writeln;
  95.   writeln ('    +   5 lines per page');
  96.   writeln ('    -   8 lines per page');
  97.   writeln ('    1  11 lines per page');
  98.   writeln ('    2  22 lines per page');
  99.   writeln ('    3  33 lines per page');
  100.   writeln ('    4  44 lines per page');
  101.   writeln ('    5  55 lines per page');
  102.   writeln ('    6  66 lines per page');
  103.   writeln ('    7  77 lines per page');
  104.   writeln ('    8  88 lines per page');
  105.   write ('    9  99 lines per page');
  106.   end;
  107.  
  108. procedure endbox;
  109. begin
  110.   window (26,19,57,24);
  111.   textbackground(red);
  112.   textcolor (white);
  113.   clrscr;
  114.   gotoxy(1,2);
  115.   writeln (' Q   Quit this program');
  116.   writeln (' V   Print 80 Char test line');
  117.   writeln (' W   Set printer to top of page');
  118.   writeln (' X   Move paper up 6 lines');
  119.   write (' Y   Initialize printer (RESET)');
  120.   end;
  121.  
  122. procedure main;
  123. const
  124.   cp: array ['A'..'F'] of integer =
  125.       (10,12,17,5,6,8);
  126. var
  127.   cpi:integer;
  128.   esc,ch:char;
  129.  
  130. begin
  131.   esc:= chr(27);
  132.   window (1,21,24,25);
  133.   textbackground (blue);
  134.   textcolor (black);
  135.   clrscr;
  136.   gotoxy (1,1);
  137.   assign (dev,'LST:');
  138.   reset (dev);
  139.   write (dev,esc,chr(64));
  140.   cpi:=10;
  141.   repeat
  142.   read (kbd,ch);
  143.   if upcase(ch) in ['A'..'Y','+','-','1'..'9'] then
  144.   begin
  145.     write (' ',upcase(ch));
  146.     if upcase(ch) in ['A'..'F'] then cpi:=cp[upcase(ch)];
  147.     case upcase(ch) of
  148.      'A': write (dev,esc,chr(66),chr(1));
  149.      'B': write (dev,esc,chr(66),chr(2));
  150.      'C': write (dev,esc,chr(66),chr(3));
  151.      'D': write (dev,esc,chr(66),chr(1),esc,chr(87),chr(1));
  152.      'E': write (dev,esc,chr(66),chr(2),esc,chr(87),chr(1));
  153.      'F': write (dev,esc,chr(66),chr(3),esc,chr(87),chr(1));
  154.      'G': write (dev,esc,chr(53));
  155.      'H': write (dev,esc,chr(52));
  156.      'I': write (dev,esc,chr(71));
  157.      'J': write (dev,esc,chr(69));
  158.      'K': write (dev,esc,chr(45),chr(1));
  159.      'L': write (dev,esc,chr(77),chr(1));
  160.      'M': write (dev,esc,chr(77),chr((cpi div 2)+1));
  161.      'N': write (dev,esc,chr(77),chr((cpi div 2)+(cpi div 4)+1)) ;
  162.      'O': write (dev,esc,chr(77),chr(cpi+1));
  163.      'P': write (dev,esc,chr(77),chr(cpi + (cpi div 2) +1));
  164.      'R': write (dev,esc,chr(65),chr(18));
  165.      'S': write (dev,esc,chr(50));
  166.      'T': write (dev,esc,chr(48));
  167.      'U': write (dev,esc,chr(65),chr(7));
  168.      'V': writeln (dev,
  169.            '1........1.........2.',
  170.            'This is a sample of an eighty character test line.........');
  171.      'W': write (dev,chr(12));
  172.      'X': write (dev,esc,chr(97),chr(6));
  173.      'Y': write (dev,esc,chr(64));
  174.      '+': write (dev,esc,chr(67),chr(5));
  175.      '-': write (dev,esc,chr(67),chr(8));
  176.      '1','2','3','4','5','6','7','8','9':
  177.           write (dev,esc,chr(67),chr((ord(ch)-ord('0')) *11));
  178.          end;
  179.     end;
  180.   until upcase(ch)='Q';
  181. end;
  182.  
  183. begin
  184.   start;
  185.   printsize;
  186.   printquality;
  187.   left;
  188.   linespace;
  189.   linesperpage;
  190.   endbox;
  191.   main;
  192.   textmode;
  193.   textbackground(blue);
  194.   clrscr;
  195.   writeln ('The printer is now set as you requested.');
  196.   writeln (dev);
  197.   end.